home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 7: Sunsite / Linux Cubed Series 7 - Sunsite Vol 1.iso / system / network / info-sys / www / tkhtml-2.3 / tkhtml-2 / tkHTML-2.3 / tix / Select.tcl < prev    next >
Encoding:
Text File  |  1995-02-12  |  7.5 KB  |  319 lines
  1. proc tixSelect {w args} {
  2.     eval tixInt_CreateWidget $w tixSel TixSelect $args
  3.     return $w
  4. }
  5.  
  6. proc tixSel::CreateClassRec {} {
  7.     global tixSel
  8.  
  9.     # OPTIONS
  10.     set tixSel(rootOptions) {}
  11.     set tixSel(options)     {-anchor -background -bg -command -font \
  12.                          -state -variable -value -buttonbg -selectedbg 
  13.                  -allowzero -radio}
  14.  
  15.     # Intrinsics must config these options after widget creation. unimplemented
  16.     set tixSel(delayOptions) {-variable}
  17.  
  18.     # DEFAULT VALUES
  19.     set tixSel(-anchor)     {-anchor anchor Anchor center}
  20.     set tixSel(-background) {-background background Background #ffe4c4}
  21.     set tixSel(-buttonbg)   {-buttonbg buttonBg Background #ffe4c4}
  22.     set tixSel(-selectedbg) {-selectedbg selectedBg SelectedBg #e4c4ff}
  23.     set tixSel(-command)    {-command command Command {}}
  24.     set tixSel(-font)       {-font font Font \
  25.                          "-*-helvetica-medium-r-normal-*-14-*-*-*-*-*-*-*"}
  26.     set tixSel(-state)      {-state state State normal}
  27.     set tixSel(-variable)   {-variable variable Variable {}}
  28.     set tixSel(-value)      {-value value Value {}}
  29.     set tixSel(-radio)      {-radio radio Radio true }
  30.     set tixSel(-allowzero)  {-allowzero allowZero AllowZero false}
  31.  
  32.     # ALIASES
  33.     set tixSel(-bg)           {= -background}
  34.     # METHODS
  35.     set tixSel(methods)       {add button invoke}
  36. }
  37.  
  38.  
  39. proc tixSel::ConstructWidget {w} {
  40.     upvar #0 $w data
  41.  
  42.     if {$data(-variable) != {}} {
  43.     tixSel::config-variable $w $data(-variable)
  44.     }
  45. }
  46.  
  47. proc tixSel::InitWidgetRec {w class className args} {
  48.     upvar #0 $w data
  49.  
  50.     set data(items)   {}
  51. }
  52.  
  53. #----------------------------------------------------------------------
  54. #                           CONFIG OPTIONS
  55. #----------------------------------------------------------------------
  56. #
  57. proc tixSel::config-anchor {w arg} {
  58.     upvar #0 $w data
  59.  
  60.     foreach item $data(items) {
  61.     $w.$item config -anchor $arg
  62.     }
  63. }
  64.  
  65. proc tixSel::config-background {w arg} {
  66.     upvar #0 $w data
  67.  
  68.     $data(rootCmd) config -bg $arg
  69. }
  70.  
  71. proc tixSel::config-buttonbg {w arg} {
  72.     upvar #0 $w data
  73.  
  74.     foreach item $data(items) {
  75.     $w.$item config -bg $arg
  76.     }
  77. }
  78.  
  79. proc tixSel::config-selectedbg {w arg} {
  80.     upvar #0 $w data
  81.  
  82.     if {$data(-state) == "normal"} {
  83.     foreach item $data(-value) {
  84.         $w.item config -bg $arg
  85.     }
  86.     }
  87. }
  88.  
  89. proc tixSel::config-font {w arg} {
  90.     upvar #0 $w data
  91.  
  92.     foreach item $data(items) {
  93.     $w.$item config -font $arg
  94.     }
  95. }
  96.  
  97. proc tixSel::config-state {w arg} {
  98.     upvar #0 $w data
  99.  
  100.     if {$arg == $data(-state)} {
  101.     return
  102.     }
  103.     if {$arg == "disabled"} {
  104.     foreach item $data(items) {
  105.         $w.$item config -state disabled -relief raised \
  106.         -bg $data(-buttonbg) 
  107.     }
  108.     } else {
  109.     foreach item $data(items) {
  110.         if {$data(w:$item) == "selected"} {
  111.         $w.$item config -relief sunken -bg $data(-selectedbg) \
  112.             -state normal
  113.         } else {
  114.         $w.$item config -relief raised -bg $data(-buttonbg) \
  115.             -command "$w invoke $item" -state normal
  116.         }
  117.     }
  118.     }
  119. }
  120.  
  121. proc tixSel::config-variable {w arg} {
  122.     upvar #0 $w data
  123.  
  124.     if {$data(-variable) != {}} {
  125.     trace vdelete $data(-variable) w "tixSel::TraceProc $w"
  126.     }
  127.  
  128.     if {$arg != {}} {
  129.     upvar #0 $arg variable
  130.     if [info exists $arg] {
  131.         $w config -value $variable
  132.     } else {
  133.         set variable $data(-value)
  134.     }
  135.     global $arg
  136.     trace variable $arg w "tixSel::TraceProc $w"
  137.     }
  138. }
  139.  
  140. proc tixSel::config-value {w arg} {
  141.     upvar #0 $w data
  142.  
  143.     # sanity checking
  144.     foreach item $arg {
  145.     if {[lsearch $data(items) $item] == "-1"} {
  146.         error "button subwidget \"$item\" does not exist"
  147.     }
  148.     }
  149.  
  150.     if {$data(-radio) == "true" && [llength $arg] > 1} {
  151.     error "cannot choose more than one items in a radio box"
  152.     }
  153.  
  154.     if {$data(-allowzero) == "false" && [llength $arg] == 0} {
  155.     error "empty selection not allowed"
  156.     }
  157.  
  158.     set data(-value0 $arg
  159.     tixSel::UpdateVariable $w
  160.  
  161.     # Reset all to be unselected
  162.     foreach item $data(items) {
  163.     if {[lsearch $arg $item] == "-1"} {
  164.         if {$data(w:$item) == "selected"} {
  165.         # was selected but now unselected
  166.         # -> popup the button, call command
  167.         $w.$item config -relief raised -bg $data(-buttonbg)
  168.         set data(w:$item) unselected
  169.         incr data(nSelected) -1
  170.  
  171.         if {$data(-command) != {}} {
  172.             eval $data(-command) $item 0
  173.         }
  174.         }
  175.     } else {
  176.         if {$data(w:$item) == "unselected"} {
  177.         # was unselected but now selected
  178.         # -> push down the button, call command
  179.         $w.$item config -relief sunken -bg $data(-selectedbg)
  180.         set data(w:$item) selected
  181.         incr data(nSelected)
  182.  
  183.         if {$data(-command) != {}} {
  184.             eval $data(-command) $item 1
  185.         }
  186.         }
  187.     }
  188.     }
  189. }
  190.  
  191. #----------------------------------------------------------------------
  192. #                     WIDGET COMMANDS
  193. #----------------------------------------------------------------------
  194. proc tixSel::add {w name args} {
  195.     upvar #0 $w data
  196.  
  197.     eval [list button $w.$name -command "$w invoke $name"\
  198.      -bg $data(-buttonbg) -font $data(-font)] $args
  199.     pack $w.$name -side left -expand yes -fill both
  200.  
  201.     if {$data(-state) == "disabled"} {
  202.     $name config -relief raised -state disabled
  203.     }
  204.  
  205.     set data(w:$name) unselected
  206.     set data(nSelected) 0
  207.  
  208.     lappend data(items) $name
  209. }
  210.  
  211. proc tixSel::button {w name args} {
  212.     upvar #0 $w data
  213.  
  214.     if {$args != {}} {
  215.     return [eval $w.$name $args]
  216.     } else {
  217.     return $w.name
  218.     }
  219. }
  220.  
  221. #call the command
  222. proc tixSel::invoke {w name} {
  223.     upvar #0 $w data
  224.  
  225.     if {$data(-state) != "normal"} {
  226.     return
  227.     }
  228.  
  229.     if {$data(w:$name) == "selected"} {
  230.     if {$data(nSelected) > 1 || $data(-allowzero) == "true"} {
  231.         $w.$name config -relief raised -bg $data(-buttonbg)
  232.         set data(w:$name) unselected
  233.         incr data(nSelected) -1
  234.         tixSel::UpdateValue $w 
  235.  
  236.         if {$data(-command) != {}} {
  237.         eval $data(-command) $name 0
  238.         }
  239.     }
  240.     } else {
  241.     if {$data(-radio) == "true"} {
  242.         set data(nSelected) 1
  243.         # cannot call Updatevalue because data(w:??) not set yet.
  244.         set data(-value) $name
  245.         tixSel::UpdateVariable $w
  246.  
  247.         foreach item $data(items) {
  248.         if {$item == $name} {
  249.             $w.$item config -relief sunken -bg $data(-selectedbg)
  250.             set data(w:$item) selected
  251.  
  252.             if {$data(-command) != {}} {
  253.             eval $data(-command) $item 1
  254.             }
  255.         } elseif {$data(w:$item) == "selected"} {
  256.             $w.$item config -relief raised -bg $data(-buttonbg)
  257.             set data(w:$item) unselected
  258.  
  259.             if {$data(-command) != {}} {
  260.             eval $data(-command) $item 0
  261.             }
  262.         }
  263.         }
  264.     } else {
  265.         $w.$name config -relief sunken -bg $data(-selectedbg)
  266.         set data(w:$name) selected
  267.         incr data(nSelected)
  268.         tixSel::UpdateValue $w 
  269.  
  270.         if {$data(-command) != {}} {
  271.         eval $data(-command) $name 1
  272.         }
  273.     }
  274.     }
  275. }
  276.  
  277. #----------------------------------------------------------------------
  278. #                Private functions
  279. #----------------------------------------------------------------------
  280. proc tixSel::UpdateValue {w} {
  281.     upvar #0 $w data
  282.  
  283.     set data(-value) {}
  284.  
  285.     foreach item $data(items) {
  286.     if {$data(w:$item) == "selected"} {
  287.         lappend data(-value) $item
  288.     }
  289.     }
  290.  
  291.     tixSel::UpdateVariable $w
  292. }
  293.  
  294. proc tixSel::UpdateVariable {w} {
  295.     upvar #0 $w data
  296.  
  297.     if {$data(-variable) != {}} {
  298.     upvar #0 $data(-variable) variable
  299.     global $data(-variable)
  300.  
  301.     trace vdelete  $data(-variable) w "tixSel::TraceProc $w"
  302.     set variable $data(-value)
  303.     trace variable $data(-variable) w "tixSel::TraceProc $w"
  304.     }
  305. }
  306.  
  307. proc tixSel::TraceProc {w name1 name2 op} {
  308.     upvar #0 $name1 var
  309.  
  310.     if {$name2 == {}} {
  311.     $w config -value $var
  312.     } else {
  313.     $w config -value $var($name2)
  314.     }
  315. }
  316.     
  317. # requirement of -valiable
  318. # 1) Always updated before -command is called
  319.